home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 7
/
Apprentice-Release7.iso
/
Source Code
/
Pascal
/
Snippets
/
DeepMaskBlitting
/
DeepBlitting.p
< prev
next >
Wrap
Text File
|
1997-04-03
|
19KB
|
546 lines
{This is a demo written by Jonathan Apple <KEROI@aol.com>, based on the demo GraphicsBuffers.}
{Changes by Ingemar:}
{}
{- Put the drawing code in a case statement, controlled by the constant kChosenBlitType.}
{- Added three variants on the QuickDraw drawing code, all significantly faster than the old}
{CopyBits/CopyMask variant (kDeepCopyMaskType), which was horribly slow due to using CopyMask}
{with an 8-bit mask.}
{- Drawing variant and sprite size is selectable through a dialog.}
{- Fixed bugs in the timing code.}
{- Made sure that CopyBits and CopyMask doesn't have to do any resizing. (IMPORTANT!)}
{- Added a hole in the mask, to make the mask region test more fair (harder for CopyBits!)}
{- Checks for 8-bit screen, 32-bit addressing and Color QD.}
{- Think Pascal compatible. (Sorry about all IFC's...)}
{- Formatted (with Think) and made the capitalizations much closer to standard (types and routines}
{capitalized, variables not.)}
{- Flushed the mouseDown.}
{- Replaced SetRect for the animation loop for a small speed increase.}
{Some comments:}
{CopyMask is known as the SLOW call for drawing, while CopyBits is the faster one, especially on 68k Macs.}
{CopyMask is particularly slow when using a deep mask. That variant should only be used when you take}
{advantage of the deep mask for anti-aliasing etc. CopyBits will beat it even with 1-bit mask.}
{The blitters have no problem to "win" the contest as long as the areas being copied are small.}
{However, with large areas and no masking, CopyBits will not be far behind - or even get ahead!}
{It did in my tests!}
{The custom blitter seems a bit buggy. The hole in the mask was no problem for CopyBits and CopyMask,}
{but the custom blitter misbehaves a bit. Also, I don't like the little added size on the rect that the custom}
{blitter needs. No, I don't know what it wrong with it. Try copying the blitter in my BloatBlitDemo for SAT}
{if you like - I think it works better.}
{Some junk is left, outcommented code that I didn't remove.}
program DeepBlitting;
uses
{$IFC UNDEFINED THINK_PASCAL}
Types, QuickDraw, OSUtils, SegLoad, Fonts, Windows, Menus, TextEdit, Dialogs,{}
Processes, Events, QuickDrawText, Types, QuickDraw, OSUtils, SegLoad, Fonts,{}
Windows, Menus, TextEdit, Dialogs, Events, QuickDrawText, QuickDraw, Icons, {}
TextUtils, Controls,
{$ELSEC}
{$SETC GENERATINGPOWERPC := FALSE}
{$ENDC}
QDOffScreen;
const
kDeepBlitType = 1;
kDeepCopyMaskType = 2;
kCopyBitsMaskType = 3;
kCopyBitsRgnType = 4;
kCopyBitsRectType = 5;
var
{The size of the sprite:}
theSize: Integer; {Suggested values: 50, 100, 300}
{The drawing type we want:}
gChosenBlitType: Integer;
var
curDev: GDHandle;
myErr: OSErr;
tempRect: Rect;
pnt: Point;
windRect: Rect;
mainPtr: WindowPtr;
myGDHandle: GDHandle;
spriteHandle, maskHandle, bgHandle: PicHandle;
offRect, offMaskRect, spriteRect, spriteRect2: Rect;
spriteWorld, maskWorld, curPort, workWorld, bgWorld: GWorldPtr;
maskRgn, tempRgn: RgnHandle;
finTime, initTime, lapseTime: Longint;
frameCnt: Longint;
framesPerSec, numSecs: Longint;
StrBuff: Str255;
{This function, by Matt Formica, merges rects}
function MergeRect (Rect1, Rect2: Rect): Rect;
var
tempRect: Rect;
begin
if Rect1.left < rect2.left then
MergeRect.left := rect1.left
else
MergeRect.left := Rect2.left;
if Rect1.top < rect2.top then
MergeRect.top := rect1.top
else
MergeRect.top := Rect2.top;
if Rect1.right > rect2.right then
MergeRect.right := rect1.right
else
MergeRect.right := Rect2.right;
if Rect1.bottom > rect2.bottom then
MergeRect.bottom := rect1.bottom
else
MergeRect.bottom := Rect2.bottom;
end; {MergeRect}
{$PUSH}
{$D-}
procedure Copy8BitsII (srcPix, destPix: PixMapHandle; srcR, destR: Rect); {this works like CopyBits}
var
destMemPtr: longintPtr; { Location in memory }
srcMemPtr: longintPtr;
numRowsToCopy: integer;
loopsPerRow: integer;
srcRowLongsOffset: integer; { rowbytes converted to long }
destRowLongsOffset: integer; { rowbytes converted to long }
srcStripRowBytes: longint; { to clear high bit of rowbytes }
destStripRowBytes: longint;
numRowLongs: integer; { number of long words per row }
pt: Point;
begin
{ High bit of pixMap rowBytes must be cleared }
srcStripRowBytes := BAnd($7FFF, srcPix^^.rowBytes);
destStripRowBytes := BAnd($7FFF, destPix^^.rowBytes);
{ Calculate starting addresses of where to blit... }
pt := srcR.topLeft;
LocalToGlobal(pt);
srcMemPtr := LongintPtr(ORD4(GetPixBaseAddr(srcPix)) + (srcStripRowBytes * pt.v) + pt.h);
pt := destR.topLeft;
LocalToGlobal(pt);
destMemPtr := LongintPtr(ORD4(GetPixBaseAddr(destPix)) + (destStripRowBytes * pt.v) + pt.h);
numRowsToCopy := srcR.bottom - srcR.top;
numRowLongs := BSR((srcR.right - srcR.left), 2);
{ Calculate the long word offset from the end of one }
{ row of the source image on the screen's pixmap to the }
{ first byte of the image in the next row. }
srcRowLongsOffset := BSR(srcStripRowBytes, 2) - numRowLongs;
destRowLongsOffset := BSR(destStripRowBytes, 2) - numRowLongs;
{ Draw source image directly onto the screen }
while numRowsToCopy > 0 do
begin
loopsPerRow := numRowLongs;
while loopsPerRow > 0 do
begin
destmemPtr^ := srcmemPtr^;
destmemPtr := LongintPtr(ORD4(destmemPtr) + sizeof(Longint));
srcmemPtr := LongintPtr(ORD4(srcmemPtr) + sizeof(Longint));
{*destMemPtr++ = *srcMemPtr++;}
{$IFC UNDEFINED THINK_PASCAL}
dec(loopsPerRow);
{$ELSEC}
loopsPerRow := loopsPerRow - 1;
{$ENDC}
end;
{ Bump to start of next row }
srcMemPtr := LongintPtr(ORD4(srcMemPtr) + sizeof(Longint) * srcRowLongsOffset);
destMemPtr := LongintPtr(ORD4(destMemPtr) + sizeof(Longint) * destRowLongsOffset);
{$IFC UNDEFINED THINK_PASCAL}
dec(numRowsToCopy);
{$ELSEC}
numRowsToCopy := numRowsToCopy - 1;
{$ENDC}
end;
end; { of Copy8BitsII }
procedure Mask8BitsII (srcPix, maskPix, destPix: PixMapHandle; srcR, maskR, destR: Rect); {this is like CopyMask}
var
destMemPtr: longintPtr; { Location in memory }
srcMemPtr: longintPtr;
maskMemPtr: longintPtr;
numRowsToCopy: integer;
loopsPerRow: integer;
srcRowLongsOffset: integer; { rowbytes converted to long }
destRowLongsOffset: integer; { rowbytes converted to long }
maskRowLongsOffset: integer;
srcStripRowBytes: longint; { to clear high bit of rowbytes }
destStripRowBytes: longint;
maskStripRowBytes: longint;
numRowLongs: integer; { number of long words per row }
pt: Point;
begin
{ High bit of pixMap rowBytes must be cleared }
srcStripRowBytes := BAnd($7FFF, srcPix^^.rowBytes);
destStripRowBytes := BAnd($7FFF, destPix^^.rowBytes);
maskStripRowBytes := BAnd($7FFF, maskPix^^.rowBytes);
{ Calculate starting addresses of where to blit... }
pt := srcR.topLeft;
LocalToGlobal(pt);
srcMemPtr := LongintPtr(ORD4(GetPixBaseAddr(srcPix)) + (srcStripRowBytes * pt.v) + pt.h);
pt := maskR.topLeft;
maskMemPtr := LongintPtr(ORD4(GetPixBaseAddr(maskPix)) + (maskStripRowBytes * pt.v) + pt.h);
pt := destR.topLeft;
LocalToGlobal(pt);
destMemPtr := LongintPtr(ORD4(GetPixBaseAddr(destPix)) + (destStripRowBytes * pt.v) + pt.h);
numRowsToCopy := srcR.bottom - srcR.top;
numRowLongs := BSR((srcR.right - srcR.left), 2);
{ Calculate the long word offset from the end of one }
{ row of the source image on the screen's pixmap to the }
{ first byte of the image in the next row. }
srcRowLongsOffset := BSR(srcStripRowBytes, 2) - numRowLongs;
destRowLongsOffset := BSR(destStripRowBytes, 2) - numRowLongs;
maskRowLongsOffset := BSR(maskStripRowBytes, 2) - numRowLongs;
{ Draw source image directly onto the screen }
while numRowsToCopy > 0 do
begin
loopsPerRow := numRowLongs;
while loopsPerRow > 0 do
begin
destmemPtr^ := Bor(BAnd(destmemPtr^, maskmemPtr^), srcmemPtr^);
destmemPtr := LongintPtr(ORD4(destmemPtr) + sizeof(Longint));
srcmemPtr := LongintPtr(ORD4(srcmemPtr) + sizeof(Longint));
maskmemPtr := LongintPtr(ORD4(maskmemPtr) + sizeof(Longint));
{*destMemPtr++ = *srcMemPtr++;}
{$IFC UNDEFINED THINK_PASCAL}
dec(loopsPerRow);
{$ELSEC}
loopsPerRow := loopsPerRow - 1;
{$ENDC}
end;
{ Bump to start of next row }
srcMemPtr := LongintPtr(ORD4(srcMemPtr) + sizeof(Longint) * srcRowLongsOffset);
destMemPtr := LongintPtr(ORD4(destMemPtr) + sizeof(Longint) * destRowLongsOffset);
maskMemPtr := LongintPtr(ORD4(maskMemPtr) + sizeof(Longint) * maskRowLongsOffset);
{$IFC UNDEFINED THINK_PASCAL}
dec(numRowsToCopy);
{$ELSEC}
numRowsToCopy := numRowsToCopy - 1;
{$ENDC}
end;
end; { of Mask8BitsII }
{$POP}
procedure Initialize;
var
mainPtr: WindowPtr;
error: OSErr;
theWorld: SysEnvRec;
begin
{$IFC UNDEFINED THINK_PASCAL}
InitGraf(@qd.thePort);
InitFonts;
InitWindows;
InitMenus;
TEInit;
InitDialogs(nil);
{$ENDC}
InitCursor;
end; {Initialize}
var
theSysEnv: SysEnvRec;
dlog: DialogPtr;
itemHit: Integer;
{Just to be independent of my compatibility glue (which I usually all get from InterfacesUI.p):}
{$IFC UNDEFINED THINK_PASCAL}
{$ELSEC}
procedure GetDialogItem (theDialog: DialogPtr; itemNo: INTEGER; var itemType: INTEGER; var item: Handle; var box: Rect);
inline
$A98D;
procedure SetControlValue (theControl: ControlHandle; theValue: INTEGER);
inline
$A963;
{$ENDC}
procedure SetBooleanDItem (itemNo: integer; theBoolean: Boolean);
var
kind: integer;
item: ControlHandle;
box: Rect;
begin
GetDialogItem(FrontWindow, itemNo, kind, Handle(item), box);
SetControlValue(item, integer(theBoolean));
end; {SetBooleanDItem}
{I replace SetRect to avoid unnecessary context switches in PPC code and to avoid trap calls}
{in 68k code. It will save time for both.}
procedure MySetRect (var r: Rect; left, top, right, bottom: Integer);
begin
r.left := left;
r.top := top;
r.right := right;
r.bottom := bottom;
end;
begin
Initialize; {sets up all the stuff we need. We do this in CW, not in TP}
{Some environment checks! Real programs fire up alerts informing about the problem.}
{We must have Color QD!}
myErr := SysEnvirons(1, theSysEnv);
if myErr <> noErr then
begin
SysBeep(1);
ExitToShell;
end;
if not theSysEnv.hasColorQD then
begin
SysBeep(1);
ExitToShell;
end;
{We must run in 8-bit! Real applications try to set the screen to that depth.}
if GetMainDevice^^.gdPMap^^.pixelSize <> 8 then
begin
SysBeep(1);
ExitToShell;
end;
{When blitting to screen, we must also be in 32-bit mode, or check that the screen}
{is reachable in 24-bit mode.}
{$IFC GENERATINGPOWERPC=FALSE }
if GetMMUMode = false32b then
begin
SysBeep(1);
ExitToShell;
end;
{$ENDC}
dlog := GetNewDialog(128, nil, WindowPtr(-1));
SetPort(dlog);
SetBooleanDItem(6, true);
theSize := 50;
itemHit := 0;
repeat
ModalDialog(nil, itemHit);
if itemHit in [6, 7, 8] then
begin
SetBooleanDItem(6, itemHit = 6);
SetBooleanDItem(7, itemHit = 7);
SetBooleanDItem(8, itemHit = 8);
case itemHit of
6:
theSize := 50;
7:
theSize := 100;
8:
theSize := 300;
end;{case}
end;
until itemHit in [kDeepBlitType..kCopyBitsRectType];
gChosenBlitType := itemHit;
DisposeDialog(dlog);
HideCursor;{Having the cursor on the screen messes up the blitting}
SetRect(windRect, 0, 0, 640, 480);
mainPtr := NewCWindow(nil, windRect, 'Pascal Blitting Test', TRUE, documentProc, Pointer(-1), FALSE, 0);
SetPort(mainPtr); { set window to current graf port }
GetGWorld(curPort, myGDHandle);
bgHandle := GetPicture(1);
spriteHandle := GetPicture(2);
maskHandle := GetPicture(3);
SetRect(offRect, 0, 0, theSize, theSize);
{SetRect(offRect, 0, 0, 50, 50);}
{SetRect(offRect,0,0,100,100);}
{For bigger tests}
{SetRect(offRect,0,0,300,300);}
{For bigger tests}
SetRect(offMaskRect, 0, 0, theSize, theSize);
{SetRect(offMaskRect, 0, 0, 50, 50);}
{SetRect(offMaskRect,0,0,100,100);}
{For bigger tests}
{SetRect(offMaskRect,0,0,300,300);}
{For bigger tests}
{$IFC UNDEFINED THINK_PASCAL}
myErr := NewGWorld(spriteWorld, 8, offRect, nil, nil, 0); {Make a world with the sprite}
{$ELSEC}
myErr := NewGWorld(spriteWorld, 8, offRect, nil, nil, []); {Make a world with the sprite}
{$ENDC}
GetGWorld(CGrafPtr(curPort), curDev);
SetGWorld(spriteWorld, nil);
if LockPixels(spriteWorld^.portPixMap) then
begin
{Put Sprites in world using DrawPicture}
EraseRect(offRect);
DrawPicture(spriteHandle, offRect);
end;
UnlockPixels(spriteWorld^.portPixMap);
SetGWorld(CGrafPtr(curPort), curDev);
if gChosenBlitType in [kCopyBitsMaskType, kCopyBitsRgnType, kCopyBitsRectType] then
{$IFC UNDEFINED THINK_PASCAL}
myErr := NewGWorld(maskWorld, 1, offRect, nil, nil, 0) {Make 1-bit world with the mask}
{$ELSEC}
myErr := NewGWorld(maskWorld, 1, offRect, nil, nil, []) {Make 1-bit world with the mask}
{$ENDC}
else
{$IFC UNDEFINED THINK_PASCAL}
myErr := NewGWorld(maskWorld, 8, offRect, nil, nil, 0); {Make a world with the mask}
{$ELSEC}
myErr := NewGWorld(maskWorld, 8, offRect, nil, nil, []); {Make a world with the mask}
{$ENDC}
GetGWorld(CGrafPtr(curPort), curDev);
SetGWorld(maskWorld, nil);
if LockPixels(maskWorld^.portPixMap) then
begin
{Put Sprites in world using DrawPicture}
EraseRect(offMaskRect);
DrawPicture(maskHandle, offMaskRect);
{Guess what: The mask is white, instead of black. For the copyBits}
{part, we must invert the rect:}
if gChosenBlitType <> kDeepBlitType then
InvertRect(offMaskRect);
end;
UnlockPixels(maskWorld^.portPixMap);
SetGWorld(CGrafPtr(curPort), curDev);
if gChosenBlitType in [kCopyBitsRgnType, kCopyBitsRectType] then
begin
maskRgn := NewRgn;
myErr := BitMapToRegion(maskRgn, GrafPtr(maskWorld)^.portBits);
tempRgn := NewRgn;
end;
{$IFC UNDEFINED THINK_PASCAL}
myErr := NewGWorld(bgWorld, 8, windRect, nil, nil, 0); {Make a background world}
{$ELSEC}
myErr := NewGWorld(bgWorld, 8, windRect, nil, nil, []); {Make a background world}
{$ENDC}
GetGWorld(CGrafPtr(curPort), curDev);
SetGWorld(bgWorld, nil);
if LockPixels(bgWorld^.portPixMap) then
begin
{Put Sprites in world using DrawPicture}
EraseRect(windRect);
DrawPicture(bgHandle, windRect);
end;
UnlockPixels(bgWorld^.portPixMap);
SetGWorld(CGrafPtr(curPort), curDev);
{$IFC UNDEFINED THINK_PASCAL}
myErr := NewGWorld(workWorld, 8, windRect, nil, nil, 0); {Make a dirty work world}
{$ELSEC}
myErr := NewGWorld(workWorld, 8, windRect, nil, nil, []); {Make a dirty work world}
{$ENDC}
GetGWorld(CGrafPtr(curPort), curDev);
SetGWorld(workWorld, nil);
if LockPixels(workWorld^.portPixMap) then
begin
{Put Sprites in world using DrawPicture}
EraseRect(windRect);
DrawPicture(bgHandle, windRect);
end;
UnlockPixels(workWorld^.portPixMap);
SetGWorld(CGrafPtr(curPort), curDev);
SetGWorld(curPort, nil);
{This is for the timing/fps calculations:}
InitTime := TickCount;
frameCnt := 0;
DrawPicture(bgHandle, windRect);
repeat
frameCnt := frameCnt + 1;{fps calc.}
GetMouse(pnt); {Hey! Where IS that mouse?}
{SetRect(spriteRect, pnt.h, pnt.v, pnt.h + 51, pnt.v + 51);}
{ Make the sprite's}
{ rect where the mouse is. Notice that I am adding 51 to the mouse's position.}
{ I'm pretty sure the reason is cause the mask is 1 pixels smaller than the sprite.}
{SetRect(spriteRect,pnt.h,pnt.v,pnt.h+103,pnt.v+103);}
{For bigger tests. }
{ It's adding 3 cause of the messed up mask for both of these. }
{ Sorry, didn't feel like going back to fix it!}
{SetRect(spriteRect,pnt.h,pnt.v,pnt.h+303,pnt.v+303);}
{For bigger test}
{I don't like that extra on the blitters; looks like a bug to me. I havn't checked what the problem is though. /Ingemar}
if gChosenBlitType = kDeepBlitType then
if theSize > 50 then
MySetRect(spriteRect, pnt.h, pnt.v, pnt.h + theSize + 3, pnt.v + theSize + 3)
else
MySetRect(spriteRect, pnt.h, pnt.v, pnt.h + theSize + 1, pnt.v + theSize + 1)
else
MySetRect(spriteRect, pnt.h, pnt.v, pnt.h + theSize, pnt.v + theSize);
case gChosenBlitType of
kDeepBlitType:
begin
{This animates the sprite. Notice it looks like CopyBits and CopyMasks,}
{ only no scaling or special effects. Also, the GWorld parameters are different!}
Copy8BitsII(bgWorld^.portPixMap, workWorld^.portPixMap, spriteRect2, spriteRect2);
Mask8BitsII(spriteWorld^.portPixMap, maskWorld^.portPixMap, workWorld^.portPixMap, offRect, offMaskRect, spriteRect);
tempRect := MergeRect(spriteRect2, spriteRect);
Copy8BitsII(workWorld^.portPixMap, CGrafPtr(curPort)^.portPixMap, tempRect, tempRect);
end;
kDeepCopyMaskType, kCopyBitsMaskType:
begin
{This is copyBits and copyMask, either with deep mask (slow!) or 1-bit mask.}
CopyBits(GrafPtr(bgWorld)^.portBits, GrafPtr(workWorld)^.portBits, spriteRect2, spriteRect2, srcCopy, nil);
CopyMask(GrafPtr(spriteWorld)^.portBits, GrafPtr(maskWorld)^.portBits, GrafPtr(workWorld)^.portBits, offRect, offMaskRect, spriteRect);
tempRect := MergeRect(spriteRect2, spriteRect);
CopyBits(GrafPtr(workWorld)^.portBits, GrafPtr(curPort)^.portBits, tempRect, tempRect, srcCopy, nil);
end;
kCopyBitsRgnType:
begin
{This is copyBits with a mask region.}
CopyBits(GrafPtr(bgWorld)^.portBits, GrafPtr(workWorld)^.portBits, spriteRect2, spriteRect2, srcCopy, nil);
CopyRgn(maskRgn, tempRgn);
OffsetRgn(tempRgn, spriteRect.left - offRect.left, spriteRect.top - offRect.top);
CopyBits(GrafPtr(spriteWorld)^.portBits, GrafPtr(workWorld)^.portBits, offRect, spriteRect, srcCopy, tempRgn);
tempRect := MergeRect(spriteRect2, spriteRect);
CopyBits(GrafPtr(workWorld)^.portBits, GrafPtr(curPort)^.portBits, tempRect, tempRect, srcCopy, nil);
end;
kCopyBitsRectType:
begin
{This is just the copyBits with NO mask.}
CopyBits(GrafPtr(bgWorld)^.portBits, GrafPtr(workWorld)^.portBits, spriteRect2, spriteRect2, srcCopy, nil);
CopyBits(GrafPtr(spriteWorld)^.portBits, GrafPtr(workWorld)^.portBits, offRect, spriteRect, srcCopy, nil);
tempRect := MergeRect(spriteRect2, spriteRect);
CopyBits(GrafPtr(workWorld)^.portBits, GrafPtr(curPort)^.portBits, tempRect, tempRect, srcCopy, nil);
end;
end; {case}
{This makes spriteRect2 where the sprite WAS:}
MySetRect(spriteRect2, spriteRect.left, spriteRect.top, spriteRect.right, spriteRect.bottom);
until Button;
{This just shows how fast it all went:}
ForeColor(33);
finTime := TickCount;
lapseTime := finTime - initTime;
{numSecs := round(lapseTime / 60);}
{framesPerSec := round(frameCnt / numSecs);}
framesPerSec := frameCnt * 60 div lapseTime;
NumToString(framesPerSec, strBuff);
TextSize(24);
MoveTo(300, 80);
DrawString(strBuff);
{MoveTo(340, 80);}
TextSize(12);
{ strBuff := (' Frames per Second ');}
DrawString(' frames per second ');
MoveTo(340, 435);
{ StrBuff := ('Click the Mouse To Exit... ');}
DrawString('Click the mouse to exit... ');
repeat
until not Button;
repeat
until Button;
FlushEvents(mDownMask, 0);
end.